;;;; scdict.lisp

(in-package #:scdict-impl)

(defun find-with-last-on-page (word index-file &key (not-lessp #'string-not-lessp) key offsets)
  (when (null key)
    (setf key #'identity))
  (with-open-file (in index-file :direction :input)
    (prog (page (volume -1) offset line)
      new-volume
          (setf offset (or (pop offsets) 1))
          (setf page (1- offset))
          (incf volume)
          (go next-line)
      next-line
          (setf line (read-line in nil))
          (cond ((null line) (go page-found))
                ((zerop (length (string-trim " " line))) (go new-volume))
                (t (incf page) (go check-word)))
      check-word
          (when (funcall not-lessp (funcall key line) (funcall key word))
            (go page-found))
          (go next-line)
      page-found
          (return (values page volume)))))

(defvar *dictionary-path* '())
(defvar *index-path* '())

(defun path-merge (pathname path)
  (if (uiop:absolute-pathname-p pathname)
      pathname
      (loop for directory in path
            for merged-pathname = (merge-pathnames pathname directory)
            when (uiop:file-exists-p merged-pathname)
            do (return merged-pathname)
            finally (return pathname))))

(defvar *dictionaries* (make-hash-table :test 'equalp))

(defstruct dictionary name title files index first-pages (not-lessp #'string-not-lessp) key)

(defun dictionary (name)
  (values (gethash name *dictionaries*)))

(defun all-dictionaries ()
  (sort (loop for d being the hash-values of *dictionaries* collect d)
        #'string<
        :key #'dictionary-name))

(defun register-dictionary (&key name title (file nil file-supplied-p) index first-page files first-pages (not-lessp #'string-not-lessp) key)
  (if file-supplied-p
      (setf files (list file)
            first-pages (and first-page (list first-page))))
  (setf (gethash name *dictionaries*)
        (make-dictionary :name name
                         :title title
                         :files (loop for file in files collect (path-merge file *dictionary-path*))
                         :index (path-merge index *index-path*)
                         :first-pages first-pages
                         :not-lessp not-lessp
                         :key key)))

(defvar *viewer* (lambda (&rest args)
                   (declare (ignore args))
                   (error "You must specify a viewer in .scdictrc.lisp")))

(defgeneric lookup (word dictionary))

(defmethod lookup (word dictionary)
  (multiple-value-bind (page volume) (find-with-last-on-page word (dictionary-index dictionary)
                                                             :offsets (dictionary-first-pages dictionary)
                                                             :not-lessp (dictionary-not-lessp dictionary)
                                                             :key (dictionary-key dictionary))
    (funcall *viewer*
             (elt (dictionary-files dictionary) volume)
             page)))

(defparameter *cli-options* '((("dictionary" #\d) :type string :optional t :documentation "Dictionary to look up in.")
                              (("help" #\h #\?) :type boolean :optional t :documentation "Print the help message.")
                              (("list-dictionaries" #\l) :type boolean :optional t :documentation "List the dictionaries.")))

(defun print-usage (stream)
  (format stream "Не так!!!"))

(defun print-dictionaries (&optional (stream *standard-output*))
  (let* ((dictionaries (sort (loop for dictionary being the hash-values of *dictionaries*
                                   collect (list (dictionary-name dictionary) (dictionary-title dictionary)))
                             #'string<
                             :key #'first))
         (first-col-width (loop for (name title) in dictionaries maximizing (length name)))
         (format-string (format nil "~~&~~{~~{~~A~~~DT  ~~A~~%~~}~~}" (+ 2 first-col-width))))
    (format stream format-string (print dictionaries)))) 

(defun interactive-lookup (dictionaries &optional (stream *query-io*))
  (flet ((prompt (dictionary)
           (format *query-io* "~A> " (dictionary-name dictionary))
           (finish-output *query-io*)))
    (loop with current-dictionary = (first dictionaries)
          initially (prompt current-dictionary)
          for line = (read-line stream nil)
          while (plusp (length line))
          do (if (char= (char line 0) #\Space)
               (setf current-dictionary (loop for dictionary in dictionaries
                                              when (eql 0 (search (string-downcase (string-left-trim " " line))
                                                                  (string-downcase (dictionary-name dictionary))))
                                              do (return dictionary)
                                              finally (return current-dictionary)))
               (lookup line current-dictionary))
          (prompt current-dictionary))))

(defun main (argv)
  (handler-case
    (macrolet ((ret (code)
                 `(return-from main ,code)))
      (multiple-value-bind (options words) (handler-case
                                             (command-line-arguments:process-command-line-options *cli-options* argv)
                                             (simple-error (c)
                                                           (format *error-output* "~A~%" c)
                                                           (print-usage *error-output*)
                                                           (ret 1)))
        (if (getf options :help)
          (print-usage *error-output*)
          (let ((dict-names (nreverse (loop for (option value) on options by #'cddr
                                            when (eql option :dictionary)
                                            collect value))))
            (when (null dict-names)
              (setf dict-names (list (pop words))))
            (let ((dictionaries (loop for name in dict-names
                                      collect (or (dictionary name) (error "Unknown dictionary ~A" name)))))
              (if (null words)
                  (interactive-lookup dictionaries)
                  (dolist (dictionary dictionaries)
                    (dolist (word words)
                      (lookup word dictionary))))
              t))))
      0)
    (simple-error (c) (format *error-output* "~A~%" c) 1)
    #+nil (error () (format *error-output* "Something went wrong.~%") 1)))

(defun init ()
  (load (merge-pathnames #p".scdictrc" (user-homedir-pathname)) :if-does-not-exist nil))
